VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsConnections"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'*---------------------------------------------------------------
'*
'* ClassName:      clsConnections
'* FileName:       CONNECTIONS.CLS
'* Date:           July 1998
'* Author:         Ian M. Weatherburn
'* Company:        Mindkey Software Solutions (Pty) Ltd.
'* Copyright:      Copyright (C) 1998 by Mindkey Software Solutions
'*                 All Rights Reserved
'* Description:    RAS Connections
'*
'*---------------------------------------------------------------

Option Explicit

' Protected variables for Connections collection
Private intCCount As Integer

Private Sub Class_initialize()
  Dim lngSuccess As Long
  
  lngSuccess = fnRASEnumConnections()
End Sub

Public Property Get Count() As Integer
  Dim lngRetCode As Long
  
  lngRetCode = fnRASEnumConnections()
  
  If lngRetCode Then
    Err.Raise vbObjectError + lngRetCode, _
              "Connections.Count Failure", _
              "RAS Failure"
  Else
    Count = intCCount
  End If
End Property

Public Function AddConnection(strNewEntryName As String, _
                              strNewPhoneNumber As String, _
                              strNewCallbackNumber As String, _
                              strNewUserName As String, _
                              strNewPassword As String, _
                              strNewDomain As String, _
                              blnAsync As Boolean _
) As clsConnection

  Dim lngRetCode As Long
  Dim hRASConn As Long
  Dim lngRetlstrcpy As Long
  Dim intLoop As Long
  Dim lngRetHangUp As Long
  Dim intCurrentTryCount As Long
  
  ' Performing RASDial asynchronous calls in a VB sort of way.
  ' Since we can not define a callback, we call the API and pass
  ' in the handle of a modal form that we have in the server.
  ' We then poll the connection with RASGetConnectionStatus()
  ' until we see that we are connected.
  
  strCurrentEntryName = strNewEntryName
  
  intCurrentTryCount = 1
  
RAS_DIAL:
  
  If lngWindowVersion = VER_PLATFORM_WIN32_NT Then
    ' We are running under Windows NT
    
    Dim lpRASDialParams As RasDialParams
    lpRASDialParams.dwSize = 736
    
    ' Using lstrcpy() because StrConv() fails
    ' VB will convert the string and fill the array
    lngRetlstrcpy = lstrcpy(lpRASDialParams.szEntryName(0), strNewEntryName)
    lngRetlstrcpy = lstrcpy(lpRASDialParams.szPhoneNumber(0), strNewPhoneNumber)
    lngRetlstrcpy = lstrcpy(lpRASDialParams.szCallBackNumber(0), strNewCallbackNumber)
    lngRetlstrcpy = lstrcpy(lpRASDialParams.szUserName(0), strNewUserName)
    lngRetlstrcpy = lstrcpy(lpRASDialParams.szPassword(0), strNewPassword)
    lngRetlstrcpy = lstrcpy(lpRASDialParams.szDomain(0), strNewDomain)
        
    ' Call RASDial()
    If blnAsync Then
    
      ' Asynchronous and ignoring RASDialExtensions
      ' so the hWND is valid
      Load frmRAS
      DoEvents
      
      lngRetCode = RasDial(ByVal APINULL, _
                           vbNullString, _
                           lpRASDialParams, _
                           RAS_NotifyWindowHandle, _
                           frmRAS.hWnd, _
                           hRASConn)
    Else
      ' Synchronous and ignoring RASDialExtensions
      Screen.MousePointer = vbHourglass
      
      lngRetCode = RasDial(ByVal APINULL, _
                           vbNullString, _
                           lpRASDialParams, _
                           APINULL, _
                           ByVal APINULL, _
                           hRASConn)
                           
      Screen.MousePointer = vbDefault
    End If ' blnAsync
    
    ' Test for failure and raise error if so
    If lngRetCode Then
      lngRASErrorNumber = lngRetCode
      strRASErrorMessage = lpRASError.fnRASErrorMessage()
      lngRetHangUp = RasHangUp(hRASConn)
      Err.Raise vbObjectError + lngRetCode, _
                "Connections AddConnection Failed", _
                "RAS Failure"
    Else
      ' Return the handle to the connection to the client if they need it.
      ' Just giving time so that Connections is updated properly
      DoEvents
    End If ' lngRetCode
  Else
    ' We are running under Windows 95
    Dim lpRASDialParams95 As RasDialParams95
    lpRASDialParams95.dwSize = 1052
    
    ' Using lstrcpy() because StrConv() fails
    ' VB will convert the string and fill the array
    lngRetlstrcpy = lstrcpy(lpRASDialParams95.szEntryName(0), strNewEntryName)
    lngRetlstrcpy = lstrcpy(lpRASDialParams95.szPhoneNumber(0), strNewPhoneNumber)
    lngRetlstrcpy = lstrcpy(lpRASDialParams95.szCallBackNumber(0), strNewCallbackNumber)
    lngRetlstrcpy = lstrcpy(lpRASDialParams95.szUserName(0), strNewUserName)
    lngRetlstrcpy = lstrcpy(lpRASDialParams95.szPassword(0), strNewPassword)
    lngRetlstrcpy = lstrcpy(lpRASDialParams95.szDomain(0), strNewDomain)
    
    ' Call RASDial()
    If blnAsync Then
      ' Asynchronous and ignoring RASDialExtensions
      ' so the hWND is valid
      Load frmRAS
      DoEvents
      
      lngRetCode = RasDial(ByVal APINULL, _
                           vbNullString, _
                           lpRASDialParams95, _
                           RAS_NotifyWindowHandle, _
                           frmRAS.hWnd, _
                           hRASConn)
    Else
      ' Synchronous and ignoring RASDialExtensions
      Screen.MousePointer = vbHourglass
      
      lngRetCode = RasDial(ByVal APINULL, _
                           vbNullString, _
                           lpRASDialParams95, _
                           APINULL, _
                           ByVal APINULL, _
                           hRASConn)
                           
      Screen.MousePointer = vbDefault
    End If ' blnAsync
    
    ' Test for failure and raise error if so
    If lngRetCode Then
      lngRASErrorNumber = lngRetCode
      strRASErrorMessage = lpRASError.fnRASErrorMessage()
      lngRetHangUp = RasHangUp(hRASConn)
      Err.Raise vbObjectError + lngRetCode, _
                "Connections AddConnection Failed", _
                "RAS Failure"
    Else
      ' Return the handle to the connection to the client if they need it.
      ' Just giving time so that Connections is updated properly
      DoEvents
    End If ' lngRetCode
  End If ' lngWindowVersion
  
  ' Return the handle to the connection to the client if they need it.
  ' Enumerate the connections so that we can return correct handle to connection object
  ' This is the only way to guarantee object without complex algorithms
  If blnAsync Then
    ' This is a KLUDGE, but I am setting the TAG of the form to the hRASConn
    ' so that I can reference it in the form without having to use PUBLIC variables
    frmRAS.lblDialAttempt.Caption = _
      "Dial Attempt: " & CStr(intCurrentTryCount) & _
      " of " & CStr(RAS_RetryCount)
    frmRAS.Tag = Hex$(hRASConn)
    blnCancelConnection = False
    
    ' Show the asynchronous form so the processing stops here
    ' and get RAS_EVENTS in the form
    SetWindowPos frmRAS.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
    frmRAS.Show vbModal
  Else
    ' Nothing to do if synchronous
  End If
  
  ' Refresh and return the function to the client
  lngRetCode = fnRASEnumConnections()
  
  If blnCancelConnection Then
    LogEvent "User Cancelled Remote Server Connection"
    Err.Raise vbObjectError + lngRetCode, _
              "Connections AddConnection Failed", _
              "RAS Failure"
    Exit Function
  End If
  
  If intCCount = 0 Then
    LogEvent "Unable to establish connection on try " & CStr(intCurrentTryCount)
    intCurrentTryCount = intCurrentTryCount + 1
    ' Retry the RAS dialling
    If intCurrentTryCount <= RAS_RetryCount Then
      ' Remove the current error
      Err.Clear
      GoTo RAS_DIAL
    Else
      Err.Raise vbObjectError + lngRetCode, _
                "Connections AddConnection Failed", _
                "RAS Failure"
    End If
  End If
  
  For intLoop = 0 To intCCount - 1
    If hRASConn = arrConnection(intLoop).hRASConn Then
      Set AddConnection = arrConnection(intLoop)
    Else
      Set AddConnection = Nothing
    End If
  Next intLoop
  
End Function

Public Sub RemoveConnection(lngIndexToRemove As Long)
  Dim lngRetCode As Long
  Dim hRASRemoveConn As Long
  
  ' Get the connection handle for a given index
  hRASRemoveConn = arrConnection(lngIndexToRemove).hRASConn
  
  ' Call RASHangUp
  lngRetCode = RasHangUp(hRASRemoveConn)
  
  If lngRetCode Then
    lngRASErrorNumber = lngRetCode
    strRASErrorMessage = lpRASError.fnRASErrorMessage()
    Err.Raise vbObjectError + lngRetCode, _
              "Connections RemoveConnection Failed", _
              "RAS Failure"
  Else
    ' Re-Index the connections
    lngRetCode = fnRASEnumConnections()
    
    If lngRetCode Then
      Err.Raise vbObjectError + lngRetCode, _
                "Connections RemoveConnection Failed", _
                "RAS Failure"
    End If
  End If
  
End Sub


Private Function fnRASEnumConnections() As Long
  Dim lngRetCode As Long
  Dim lpcb As Long
  Dim lpcConnections As Long
  Dim intArraySize As Integer
  Dim intLoop As Integer
  
  ' Allocating for a maximum of 256 entries.
  ' If it fails then we resize
  If lngWindowVersion = VER_PLATFORM_WIN32_NT Then
    ' We are running under Windows NT
    ReDim lpRASConn(intArraySize) As RASConn
    
    lpRASConn(0).dwSize = 32
    lpcb = 256 * lpRASConn(0).dwSize
    
    lngRetCode = RasEnumConnections(lpRASConn(0), lpcb, lpcConnections)
  Else
    ' We are running under Windows 95
    ReDim lpRASConn95(intArraySize) As RASConn95
    
    lpRASConn95(0).dwSize = 412
    lpcb = 256 * lpRASConn95(0).dwSize
    
    lngRetCode = RasEnumConnections(lpRASConn95(0), lpcb, lpcConnections)
  End If
  
  Select Case lngRetCode
    Case RAS_SUCCESS
      ' Resize array so that it is the correct size
      ' based on the return from the above function
      If lpcConnections > 0 Then
        
        ReDim arrConnection(lpcConnections - 1) As clsConnection
        
        If lngWindowVersion = VER_PLATFORM_WIN32_NT Then
          ' We are running under Windows NT
          For intLoop = 0 To UBound(arrConnection())
            Set arrConnection(intLoop) = New clsConnection
            
            ' Allow EntryName Update
            blnAllowUpdate = True
            
            arrConnection(intLoop).hRASConn = _
              lpRASConn(intLoop).hRASConn
            arrConnection(intLoop).EntryName = _
              fnTrimNulls(StrConv(lpRASConn(intLoop).szEntryName, vbUnicode))
            arrConnection(intLoop).Index = _
              intLoop
              
            blnAllowUpdate = False
          Next intLoop
        Else
          ' We are running under Windows 95
          For intLoop = 0 To UBound(arrConnection())
            Set arrConnection(intLoop) = New clsConnection
            
            ' Allow EntryName Update
            blnAllowUpdate = True
            
            arrConnection(intLoop).hRASConn = _
              lpRASConn95(intLoop).hRASConn
            arrConnection(intLoop).EntryName = _
              fnTrimNulls(StrConv(lpRASConn95(intLoop).szEntryName, vbUnicode))
            arrConnection(intLoop).Index = _
              intLoop
              
            blnAllowUpdate = False
          Next intLoop
        End If
      End If
      
      ' Set the Connections.Count
      intCCount = CInt(lpcConnections)
      
      fnRASEnumConnections = 0
      
    Case ERROR_BUFFER_TOO_SMALL
      ' Make buffers bigger and try again
      If lngWindowVersion = VER_PLATFORM_WIN32_NT Then
        ' We are running under Windows NT
        intArraySize = lpcb / lpRASConn(0).dwSize
      Else
        ' We are running under Windows 95
        intArraySize = lpcb / lpRASConn95(0).dwSize
      End If
      
    Case Else
      lngRASErrorNumber = lngRetCode
      strRASErrorMessage = lpRASError.fnRASErrorMessage()
      fnRASEnumConnections = lngRetCode
  End Select
End Function



'*---------------------------------------------------------------
'* EOF: clsConnections
'*---------------------------------------------------------------
